00100	      SUBROUTINE MSCAN
00200	CXX	DOUBLE PRECISION JFLNM,INST,INAM
00300	      DIMENSION TONES(21)
00400		COMMON LL  /P/W(1)
00500	CIN   COMMON /TR/I(80),RX(100),JX(100),LX(12),INST(27,4),K
00600	CC      COMMON /I/I(1) /TR/RX(80),JX(80),LX(12),K 
00700		COMMON /ROUT/I(200),RX(80),JX(80) /TR/LX(12),K
00800	     1,INSNUM(27),P(30),NPAR(27),JSEM,IPRNT,IPP
00900	     1,SRATE,RNCHN,RMAG,INUM,INS,MM,M,N,JJ,X,Y,IK
01000	     1,ENDX,J  /KNAM/IPLAY,JFLNM
01100		1 /INST/INST(1)
01200	      COMMON /SBFILN/SBFILN /AR/IOP /IGEN/IGEN /JP/JPRNT
01300	      INTEGER RPR
01400	      EQUIVALENCE (LESS,LX(9)),(W1,W(1)),(W2,W(2)),(W3,W(3)),(W4,W(4)),
01500	     1 (RX2,RX(3)),(P2,P(2)),(RX3,RX(5)),(I3,I(3))
01600	     1 ,(ISEMI,LX(2)),(IAST,LX(3))
01700	     1,(LPR,LX(11)),(RPR,LX(12)),(ICOM,LX(10)),(LAROW,LX(7))
01800	      DATA TONES/246.945,261.62,277.18,277.8,293.66,311.13,311.13,
01900	     1 329.63,349.23,329.63,349.23,369.99,369.99,
02000	     1 391.99,415.31,415.31,440.0,466.16,466.16,493.89,523.24/
02100	
02200	C**** CODE NUMS. 1=OUT 2=OSC 3=AD2 4=RAN 5=END 6=STR 7=AD3 8=AD4 9=MLT
02300	C**** 10=DIV 11=RAH 12=END 13=REV 14=OPT 15=NOS 16=SUB 17=INP  18=COS
02400	C**** B1=101 ETC.  P1=201 ETC.  F1=301 ETC. FREQ-PARAMS=600S, DURS=700S.
02500	C**** 400=PLAY 401=FINI 402=SRATE 403=NCHNS 404=PRINT 405=CHA 
02600	C**** 407=SRT 409=GEN 410=SEG 411=SIN  412=INS 413=UNIT GEN.
02700	C**** 500=CF 501=C 502=CS 503=DF 504=D 505=DS 506=EF 507=E 508=ES 509=FF
02800	C**** 510=F 511=FS 512=GF 513=G 514=GS 515=AF 516=A 517=AS 518=BF 519=B 520=BS
02900	
03000		JSEM=0
03100	C IS THIS NEEDED HERE?
03200	C JSEM=0 FOR 'PLAY' OR ASSIGNMENT ( P3←440;,  A=444; ETC.)
03300	      LL=1
03400	      INS=-1
03500	34      J=J+2      
03600	2324	FORMAT(1X20F10.3/)
03700	2325	FORMAT(1X20I/)
03800	2323	FORMAT(1X20A1/)
03900	      IXJ=JX(J)      
04000	      IPP=0             
04100	C!FOR 'P3←333;' ETC.
04200	      IOP=-1
04300	9      IF(J.GE.MM)GO TO 1001  
04400	      IF(RX(J+1).EQ.-9999.0)GO TO 11  
04500	C!*** SKIP IF NUMBER
04600	      IF(IGEN.GT.0)GO TO 450
04700	C IGEN=2=INSIDE AN INST. DEFINITION.
04800	
04900	C!***** LOOK FOR SPECIAL WORDS
05000		IF(IXJ/400.NE.1)GO TO 402
05100		K=IXJ-399
05200	C			   PRINT
05300	       GO TO (13,13,304,303,302,303,4,505,505,422,422,422,32)K
05400	C 	(PLAY) FINI SRAT NCHN   CHA   SRT     GEN SEG SIN INS
05500	32      W1=2
05600		IXJ=13
05700		JX(J)=13
05800	      IGEN=2
05900	      GO TO 424
06000	505      JK=4         
06100	C !**** FOR SRT
06200	      IF(K.NE.4)JK=2      
06300	      JK=J+JK
06400	      GO TO 304
06500	
06600	450	K=IXJ
06700	C** HERE FOR INST DEFINITIONS.
06800	CC	IF(K.LE.13.AND.K.GT.0)GO TO(425,425,425,425,425
06900	CC	1,425,425,425,425,425,425,411),K
07000	CC	IF(K.EQ.14)GO TO 425
07100	C 14='OPT' USER-ADDED UNIT GENERATOR.
07200		IF(K.EQ.12)GO TO 412
07300		IF(K.GT.0)GO TO 425
07400	CC503      JSEM=0
07500	CC      J=MM
07600	CC      RETURN   
07700		GO TO 1001
07800	504      FORMAT(' UNKNOWN SYMBOL ',A4)
07900	412       LL=3
08000	      IGEN=1   
08100	C!*** =1 IS FLAG TO CHANGE IT TO -1
08200	      J=MM
08300	      INS=-1
08400	      GO TO 10  
08500	422      W1=3   
08600	C!***** GEN
08700		IF(K.GT.10)W1=K-4
08800	C SEG=11, SIN=12  AT THIS POINT.
08900	      IGEN=0
09000	424      INS=-1
09100	      LL=2
09200	      GO TO 36
09300	425      W3=K+100
09400	436      LL=4  
09500	      GO TO 36
09600	
09700	CC3      J=J+2      
09800	C 'PLAY' IS NO LONGER NEEDED.
09900	C   !**** FOUND 'PLAY;'
10000	CC      IF(JX(J).NE.ISEMI)CALL ERR(1)
10100	C FLAG FOR 'TRANS' 
10200	CXXX  IPLAY=-1
10300	CC      IF(J.LT.MM)GO TO 34
10400	CC	PAUSE 'BEFORE LABEL 4'
10500	CC      RETURN
10600	4      JL=LL
10700	      JOP=IOP
10800	      J=J+2
10900	      IF(JX(J).NE.LPR)CALL ERR(2)
11000	      IOP=-1
11100	      GO TO 36  
11200	C!**FIND NUM UP TO THE COMMA
11300	302      LL=1
11400	      IPRNT=-1    
11500	C!***** FOR 'PRINT' FEATURE
11600	      GO TO 36
11700	304      SRATE=RX(J+4)
11800	      J=J+6
11900	      RMAG=512./SRATE
12000	      W3=4
12100	      W4=SRATE
12200	351      W1=11
12300	      W2=0
12400	      IGEN=0
12500	      LL=5
12600	C JSEM=-1  = SEND DATA BACK TO MUS5,PASS3.
12700	10	JSEM=-1
12800		RETURN
12900	CCC303      IF(IXJ.EQ.405)J=J-2
13000	303   RNCHN=RX(J+4)    
13100	C!**** FOR NCHNS←N;  OR  CHA ← N;
13200	      J=J+6
13300	CC      IF(RX(JK+1).NE.-9999.0)JK=JK+2  
13400	C!*** SKIP A COMMA
13500	CC      IF(JX(JK+2).EQ.ISEMI)GO TO 352  
13600	C!*** FOR NCHNS←n;
13700	352      W3=8            
13800	C!*** FOR NCHNS
13900	      W4=RNCHN-1
14000	      GO TO 351
14100	36      J=J+2      
14200	      IF(J.GT.MM)GO TO 1001        
14300	C!******  50 = DONE
14400	CC      JK=J*2
14500	CCC      IXJ=JX(J)      
14600	CX	TYPE 2324,RX(J+1)
14700	CX	TYPE 2323,IXJ
14800	CX	TYPE 2325,IXJ,IOP,IGEN
14900	CX	PAUSE 'LABEL 36'
15000		IF(IPLAY.LT.0)P(LL-3)=W(LL-1)
15100	C  **** LL HAD BETTER ALWAYS BE >3 HERE.
15200	C  FILL UP PARAM LIST WITH DATA FOLLOWING INST NAME.
15300	1002  	IXJ=JX(J)
15400		IF(IXJ.NE.ISEMI)GO TO 1
15500		IPLAY=0
15600	1000      IF(IPP.EQ.0)GO TO 10
15700	      P(IPP)=W1
15800	      LL=1
15900	      IPP=0
16000	      IF(J.LT.MM)GO TO 34  
16100	CC      IF(J.LT.MM)GO TO 30  
16200	      INS=-1   
16300	C!*** I HOPE THIS IS THE RIGHT PLACE FOR THIS.
16400	CX	PAUSE 'LABEL 1001'
16500	1001      JSEM=0
16600		RETURN
16700	
16800	1      IF(RX(J+1).NE.-9999.0)GO TO 2
16900	CX	TYPE 2325,IOP
17000	CX	PAUSE 'LABEL 1'
17100	11	IF(IOP.LT.0)GO TO 40
17200	      IF(IOP.NE.6)GO TO 12
17300	      RX(J)=-RX(J)  
17400	C!*** IOP=6 MEANS MINUS WITH COMMA IN FRONT
17500	      W(LL)=RX(J)
17600	      LL=LL+1
17700	      GO TO 14
17800	12	CALL ARITH(RX(J),W,LL)
17900	14      IOP=-1    
18000	C!*** RESET OPERATOR FLAG
18100	      GO TO 36   
18200	C!*** USE PARENTH'S FOR COMPOSITE EXPRESSIONS!!!!
18300	
18400	40	     W(LL)=RX(J)
18500	38      LL=LL+1
18600	      IF(IOP.LT.0)GO TO 36
18700	C IOP = NEG = NO OPERATOR BEFORE THIS ITEM.
18800	      LL=LL-1
18900	380      CALL ARITH(W(LL),W,LL)
19000	      GO TO 14
19100	
19200	C!**** READING CONTINUATION LINE.
19300	402	IF(IXJ.GE.0)GO TO 33
19400	C NEXT TRIES TO FIND INST. NAME.
19500	CIN	NA=-1-IXJ
19600	CIN	M=JX(J+1)
19700	C NA POINTS TO SPOT IN I ARRAY, M IS WDCNT.
19800		CALL PACKER(INAM,I(-IXJ))
19900		DO 233 IK=1,INUM
20000	233	IF(INST(IK).EQ.INAM)GO TO 333
20100		TYPE 504,INAM
20200		GO TO 33
20300	CIN	DO 133 IK=1,INUM
20400	CIN	DO 233 II=1,M
20500	CIN233	IF(INST(IK,II).NE.I(II+NA))GO TO 133
20600	C NOW WE FOUND AN INST. NAME.
20700	C******* INST NAMES CANNOT HAVE SAME STRING OF 1ST LETTERS AS OTHER THINGS.
20800	333	IPLAY=-1
20900	C FLAG TO START FILLING PARAMS.
21000	      W2=INSNUM(IK)      
21100	C!**** W IS P ARRAY IN MUSIC5
21200	      LL=3      
21300	C!**** W2 AND W3 WILL BE EXCHANGED LATER
21400		J=J+2
21500		GO TO 1002
21600	CC333	IF(M.EQ.4)GO TO 35
21700	CC	M=M+1
21800	CC	IF(INST(IK,M).EQ.0)GO TO 333
21900	CIN133	CONTINUE
22000	33    INS=2      
22100	C! NEXT IS SOMETHING OUTSIDE OF INST. AND PARAMS.
22200	
22300	2      IF(IGEN.GT.0)GO TO 427
22400		IF(IXJ.GT.520)GO TO 341
22500		IF(IXJ.LT.500)GO TO 427
22600	C NOW FOUND A NOTE
22700		K=IXJ-499
22800	      W(LL)=TONES(K)
22900	      GO TO 38
23000	C!***** FINDS NOTE IN SCALE
23100	
23200	C!****** FIND A PARAM NUM.
23300	427	IF(IXJ.GE.300)GO TO 307
23400		IF(IXJ.LT.200)GO TO 344
23500		K=IXJ-200
23600	C NOW K HAS PARAM NUM.
23700	      IF(INS.LE.0)GO TO 340
23800	      JK=J+2      
23900	      IF(JX(JK).NE.LAROW)GO TO 340
24000	      IPP=K
24100	      LL=1
24200	      J=JK      
24300	      GO TO 36
24400	340      W(LL)=P(K)      
24500	C!***** FOUND Pn
24600	      IF(IPRNT.LT.0)GO TO 38
24700	      IF(IGEN.GT.0)W(LL)=K+2.  
24800	C!*** PARAM NUMS ARE 2 LESS THAN IN BOOK.
24900	      GO TO 38    
25000	C!**** P4 IS CHANGED TO 6
25100	307    IF(IXJ.GE.400)GO TO 344
25200	
25300		IF(IXJ/300.NE.1)GO TO 344
25400		JL=IXJ-300
25500	      IF(IGEN.GT.0)JL=-JL-100      
25600	C!*** FOR Fn IN INST DEFINITION
25700	      W(LL)=JL
25800	      GO TO 38
25900	
26000	344      IF(IGEN.LE.0)GO TO 341
26100	C*** FOR B1, ETC. IN INST. DEFS.
26200		IF(IXJ/100.NE.1)GO TO 341
26300		 W(LL)=100-IXJ
26400	      GO TO 38
26500	
26600	341      DO 39 K=3,6
26700	      IF(LX(K).NE.IXJ)GO TO 39
26800		IF(K.NE.3)GO TO 342
26900		IF(JX(J+2).NE.IAST)GO TO 342
27000	C NOW FOUND 'X**Y', =X TO THE POWER OF Y
27100		K=7
27200		J=J+2
27300	342      IOP=K-2
27400	C IOP NUMS ARE: 1=+  2=-  3=*  4=/  5=**
27500	      JK=JX(J-2)
27600	      IF(JK.EQ.ICOM)IOP=6 
27700	C!** COMMA DISABLES NEXT OPERATOR
27800	      IF(JK.EQ.LAROW)IOP=6 
27900	C!**  ← DISABLES NEXT OPERATOR
28000	      IF(JK.EQ.LPR)IOP=6 
28100	C!** LFT PARENTH. DISABLES NEXT OPERATOR
28200	      GO TO 36
28300	39      CONTINUE
28400	308      IF(IXJ.EQ.LAROW)GO TO 36   
28500	C!*** PASS LEFT ARROW
28600		IF(IXJ.EQ.RPR)GO TO 500
28700		IF(IXJ.EQ.LPR)GO TO 500
28800	C LEFT AND RIGHT PARENTHESES
28900		IF(IXJ.NE.402)GO TO 510
29000	C 402=SRATE
29100		W(LL)=SRATE
29200	335      LL=LL+1
29300	      GO TO 36
29400	C**** OR SHOULD NEXT BE 403???
29500	510      IF(IXJ.NE.403)GO TO 511
29600	C 403-'NCHNS'
29700	      W(LL)=RNCHN
29800	      GO TO 335
29900	511      IF(IXJ.NE.ICOM)RETURN
30000	CC	GO TO 36
30100	CC511      IF(IXJ.NE.ICOM)GO TO 503       
30200	C!***** UNKNOWN CHAR.
30300	500      IF(IXJ.NE.LPR)GO TO 501
30400	      KOP=IOP
30500	      IOP=-1
30600	      JL=LL      
30700	C!**** SAVE VARIOUS POINTERS WHEN INSIDE PARENTHS.
30800	      GO TO 36
30900	501      IF(IXJ.NE.RPR)GO TO 502
31000	C!*** GET BACK STUFF
31100	      IOP=KOP
31200	      IF(IOP.LT.0)GO TO 36
31300	      LL=JL
31400	      GO TO 380      
31500	C!GO DO ARITHMETIC
31600	502      IF(IPRNT)GO TO 36     
31700	C!**** FOUND COMMA IN PRINT STATEMENT.
31800	5      IF(JX(J-2).NE.ICOM)GO TO 132
31900	433      W(LL)=P(LL-2)   
32000	C!** ONLY CARES ABOUT 2 COMMAS IN A ROW
32100	      GO TO 335
32200	132      IF(INS.GE.0)GO TO 36
32300	CC      IF(LL.EQ.3)GO TO 433      
32310	        IF(LL.NE.3.OR.IGEN.GE.0)GO TO 36      
32400	C!*** =3 MEANS COMMA FOR P1. (CHECK "IGEN" ABOVE ?)
32550		GO TO 433
32600	
32700	13      LL=2
32800	      W1=6
32900	CC      W2=ENDX+.5   
33000		W2=ENDX
33100	C!***** ENDX IS P1+P2 OF THE LONGEST LASTING INST.
33200	      IF(JPRNT)TYPE 51,LL,W1,W2
33300	130      J=MM
33400	C!*** WON'T READ LINE BEYOND 'FINISH;'  ***************
33500	      ENDX=-1
33600	51      FORMAT(I3,35F10.3)
33700	      END
33800